home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / tvdmx.exe / COLLECTR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-16  |  9.0 KB  |  311 lines
  1.  
  2. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  3. {                            }
  4. {    COLLECTR  --Collection Data Editing Demo    }
  5. {    tvDMX     --data editing project        }
  6. {                            }
  7. {    Copyright (c) 1992  Randolph Beck        }
  8. {                P.O. Box  56-0487        }
  9. {                Orlando, FL 32856        }
  10. {                CIS:  72361,753        }
  11. {                            }
  12. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  13.  
  14. Program COLLECTR;
  15.  
  16. (*  This program demonstrates how to use unit tvDMXCOL.PAS with a collection
  17.     of records and a collection of objects.  tvDMXCOL uses TDmxCollector (a
  18.     tvDMX descendant object) to edit data in collections.
  19.  
  20.     Although TDmxCollector can be derived to work with sorted collections,
  21.     this would require some changes to the EvaluateRecord() method.
  22.     Even so, this perpetual sorting could disturb the user, so it might
  23.     still be best to transfer the data to a non-sorting collection and then
  24.     sort again afterward.
  25.  
  26.     TDmxCollectorWin is a TDmxWindow derivative that uses TDmxCollector.
  27.  
  28.     Both of the sample windows in this program are of the same structure and
  29.     appearance, but this was only to make my work easier.  It should be easy
  30.     to insert TDmxCollectorWin-windows into your programs with your data.
  31.     Just make sure that your DMX template matches the data.
  32.  
  33.  
  34.   Function fldObjectVMT (Obj : PObject) : string;
  35.  
  36.    ...generates a template prefix for an object's virtual method table.
  37.     This is declared in unit tvDMXCOL.  It should be used with collections
  38.     of TObject derivatives so that tvDMX can create VMT's when new records
  39.     are entered.  Object Obj is disposed after its VMT code is known.
  40.  
  41.     The template prefix is actually a pair of hidden fields with default
  42.     values as that of the VMT ID.
  43.  
  44.     Procedure ObjWindow() uses this function.
  45.  
  46.  *)
  47.  
  48. {$V-,X+,B-,R- }
  49.  
  50. uses
  51.     Objects, Drivers, Memory, Views, Menus, App, MsgBox,
  52.     RSet, DmxGizma, tvDMX, StdDMX, tvDMXCOL, tvDMXREP, tvGizma;
  53.  
  54. const
  55.     cmRecWin     =  101;
  56.     cmObjWin     =  102;
  57.     cmReport     =  103;
  58.  
  59.     { This is the label and template for record TMyRecord. }
  60.  
  61.     _RecLabels   =  ' String Field          String Field 2          +Real         Real      Word   Seg : Ofs ';
  62.     RecTemplate  =  ' ssssssssssssssssssss| ssssssssssssssssssss║RRRRRRR.RRR |($rr,rrr.rr)|WWWWW ║ HHHH:HHHH ';
  63.     RecLabels    :  string [length (_RecLabels)]   =  _RecLabels;
  64.  
  65.  
  66.  
  67.     { This is the label and template for object TMyObject. }
  68.  
  69.     _ObjLabels   =  ' String Field          String Field 2          +Real         Real      Word   Seg : Ofs ';
  70.     ObjTemplate  =  ' ssssssssssssssssssss| ssssssssssssssssssss║RRRRRRR.RRR |($rr,rrr.rr)|WWWWW ║ HHHH:HHHH ';
  71.     ObjLabels    :  string [length (_ObjLabels)]   =  _ObjLabels;
  72.     { The codes to provide for a VMT are concatenated in TApp.ObjWindow. }
  73.  
  74.  
  75. type
  76.     PRecCollection  = ^TRecCollection;
  77.     TRecCollection  =  OBJECT (TCollection)
  78.       procedure FreeItem (Item : pointer);  VIRTUAL;
  79.     end;
  80.  
  81.  
  82.     PMyRecord  = ^TMyRecord;
  83.     TMyRecord  =  RECORD
  84.         S1     : string [20];
  85.         S2     : string [20];
  86.         R1,R2  : real;
  87.         W      : word;
  88.         P      : pointer;
  89.     end;
  90.  
  91.  
  92.     PMyObject  = ^TMyObject;
  93.     TMyObject  =  OBJECT (TObject)
  94.         S1     : string [20];
  95.         S2     : string [20];
  96.         R1,R2  : real;
  97.         W      : word;
  98.         P      : pointer;
  99.       constructor Init (AS1,AS2 :string; AR1,AR2 :real; AW :word; AP :pointer);
  100.     end;
  101.  
  102.  
  103.     TApp          =  OBJECT (TAppA)
  104.       procedure HandleEvent (var Event : TEvent);  VIRTUAL;
  105.       procedure Idle;  VIRTUAL;
  106.       procedure InitMenuBar;  VIRTUAL;
  107.       procedure RecWindow;
  108.       procedure ObjWindow;
  109.     end;
  110.  
  111.  
  112. var
  113.     RecCollection  :  PRecCollection;
  114.     ObjCollection  :  PCollection;
  115.  
  116.  
  117.   { ══ TRecCollection ════════════════════════════════════════════════════ }
  118.  
  119.  
  120. procedure TRecCollection.FreeItem (Item : pointer);
  121. begin
  122.   If (Item <> nil) then Dispose (PMyRecord (Item));
  123. end;  
  124.  
  125.  
  126.   { ══ TMyObject ═════════════════════════════════════════════════════════ }
  127.  
  128.  
  129. constructor TMyObject.Init (AS1,AS2 :string; AR1,AR2 :real; AW :word; AP :pointer);
  130. begin
  131.   TObject.Init;
  132.   S1 := AS1;
  133.   S2 := AS2;
  134.   R1 := AR1;
  135.   R2 := AR2;
  136.   W  := AW;
  137.   P  := AP;
  138. end;
  139.  
  140.  
  141.   { ══ TApp ══════════════════════════════════════════════════════════════ }
  142.  
  143.  
  144. procedure TApp.HandleEvent (var Event : TEvent);
  145.  
  146.     procedure DoReport;
  147.     begin
  148.       DmxReportBox ('Working', 'Processing report...'^M^M^C'COLLECTR.OUT',
  149.     New (PDmxReportFile, Init (Message (DeskTop, evCommand, cmDMX_RollCall, @Self),
  150.          '|', TRUE, 50,78, 'COLLECTR.OUT')));
  151.     end;
  152.  
  153. begin
  154.   TAppA.HandleEvent (Event);
  155.   If Event.What = evCommand then
  156.     begin
  157.     Case Event.Command of
  158.       cmRecWin:        RecWindow;
  159.       cmObjWin:        ObjWindow;
  160.       cmReport:        DoReport;
  161.      else        Exit;
  162.       end;
  163.     ClearEvent (Event);
  164.     end;
  165. end;
  166.  
  167.  
  168. procedure TApp.Idle;
  169. begin
  170.   TAppA.Idle;
  171.   If (Message (DeskTop, evCommand, cmDMX_RollCall, @Self) <> nil) then
  172.     EnableCommands ([cmReport])
  173.    else
  174.     DisableCommands ([cmReport]);
  175. end;
  176.  
  177.  
  178. procedure TApp.InitMenuBar;
  179. var  R: TRect;
  180. begin
  181.   GetExtent (R);
  182.   R.B.Y := R.A.Y + 1;
  183.   MenuBar := New (PMenuBar, Init (R, NewMenu (
  184.     NewSubMenu ('~C~ollector', hcNoContext, NewMenu (
  185.       NewItem ('~R~ecords',  'F3',  kbF3,   cmRecWin, hcNoContext,
  186.       NewItem ('~O~bjects',  'F4',  kbF4,   cmObjWin, hcNoContext,
  187.       NewItem ('R~e~port',   'F9',  kbF9,   cmReport, hcNoContext,
  188.       NewLine (
  189.       NewSoundItem (hcNoContext,  { these are methods of TAppA }
  190.       NewVideoItem (hcNoContext,  { this item appears only on hi-res systems }
  191.       NewLine (
  192.       NewItem ('e~X~it',  'Alt-X',  kbAltX, cmQuit,   hcNoContext,
  193.       nil))))))))),
  194.     NewSubMenu ('~W~indow', hcNoContext, NewMenu (
  195.       NewItem ('~S~ize/Move', 'Ctrl-F5', kbCtrlF5, cmResize, hcNoContext,
  196.       NewItem ('~Z~oom',      'F5',  kbF5,    cmZoom, hcNoContext,
  197.       NewItem ('~T~ile',      '',    kbNoKey, cmTile, hcNoContext,
  198.       NewItem ('C~a~scade',   '',    kbNoKey, cmCascade, hcNoContext,
  199.       NewItem ('~N~ext',      'F6',  kbF6,    cmNext, hcNoContext,
  200.       NewItem ('~P~revious', 'Shift-F6', kbShiftF6, cmPrev, hcNoContext,
  201.       NewItem ('~C~lose', 'Alt-F3',  kbAltF3, cmClose, hcNoContext,
  202.       NewLine (
  203.       NewItem ('~U~ser screen', 'Alt-F5', kbAltF5, cmUserScreen, hcNoContext,
  204.       nil)))))))))),
  205.     nil)))
  206.   ));
  207. end;
  208.  
  209.  
  210. procedure TApp.RecWindow;
  211. var  R  : TRect;
  212. begin
  213.   AssignWinRect (R, 0,0);
  214.   DeskTop^.Insert (ValidView (New (PDmxCollectorWin, Init (R,
  215.         'Record Editor',
  216.         NextWindowNumber,
  217.         RecTemplate,
  218.         RecCollection,
  219.         0,  { maximum collection size (0=no limit; -1=no expansions) }
  220.         RecLabels, 11)
  221.     )));
  222. end;
  223.  
  224.  
  225. procedure TApp.ObjWindow;
  226. var  R  : TRect;
  227. begin
  228.   AssignWinRect (R, 0,0);
  229.   DeskTop^.Insert (ValidView (New (PDmxCollectorWin, Init (R,
  230.         'Object Editor',
  231.         NextWindowNumber,
  232.         fldObjectVMT (New (PMyObject,Init ('','',0.,0.,0,nil)))
  233.          + ObjTemplate,
  234.         ObjCollection,
  235.         0,  { maximum collection size (0=no limit; -1=no expansions) }
  236.         ObjLabels, 11)
  237.     )));
  238. end;
  239.  
  240.  
  241.   { ══════════════════════════════════════════════════════════════════════ }
  242.  
  243.  
  244. procedure InitializeData;
  245. { creates test data }
  246.  
  247.     function NewRec (AS1,AS2 :string; AR1,AR2 :real; AW :word; AP :pointer) : PMyRecord;
  248.     var PR : PMyRecord;
  249.     begin
  250.       New (PR);
  251.       With PR^ do
  252.     begin
  253.     S1 := AS1;
  254.     S2 := AS2;
  255.     R1 := AR1;
  256.     R2 := AR2;
  257.     W  := AW;
  258.     P  := AP;
  259.     end;
  260.       NewRec := PR;
  261.     end;
  262.  
  263. begin
  264.   RecCollection^.Insert (NewRec ('Abigail Adams',  'Massachusetts',1,1, 1, pointer (MemL [0:0])));
  265.   RecCollection^.Insert (NewRec ('Betty Boop',     'ToonTown',     2,2, 2, pointer (MemL [0:4])));
  266.   RecCollection^.Insert (NewRec ('Charlie Chaplin','IBM Archives', 3,3, 3, pointer (MemL [0:8])));
  267.   RecCollection^.Insert (NewRec ('Doris Day',      'Hollywood',    4,4, 4, pointer (MemL [0:12])));
  268.   RecCollection^.Insert (NewRec ('Elbert Eagleton','Elm Street',   5,5, 5, pointer (MemL [0:16])));
  269.  
  270.   ObjCollection^.Insert (New (PMyObject, Init ('Adam West', 'Gotham City', 1,1, 1, pointer (MemL [0:20]))));
  271.   ObjCollection^.Insert (New (PMyObject, Init ('Burt Ward', 'Gotham City', 2,2, 2, pointer (MemL [0:24]))));
  272. end;
  273.  
  274.  
  275.   { ══════════════════════════════════════════════════════════════════════ }
  276.  
  277.  
  278. procedure CloseData (Name : string;  Collection : PCollection);
  279. { displays count of records in a collection, and disposes of the collection }
  280. var  S : string;
  281. begin
  282.   FormatStr (S, '%d (0%xH) records entered into %s.',
  283.          dparam (Collection^.Count,
  284.          dparam (Collection^.Count,
  285.          sparam (@Name,
  286.              nil)))^
  287.     );
  288.   PrintStr (S + ^M^J);
  289.   Collection^.FreeAll;
  290.   Dispose (Collection, Done);
  291. end;
  292.  
  293.  
  294.   { ══════════════════════════════════════════════════════════════════════ }
  295.  
  296.  
  297. var  MyApp : TApp;
  298.  
  299. Begin
  300.   New (RecCollection, Init (200, 10));
  301.   New (ObjCollection, Init (200, 10));
  302.   InitializeData;
  303.  
  304.   MyApp.Init;
  305.   MyApp.Run;
  306.   MyApp.Done;
  307.  
  308.   CloseData ('RecCollection', RecCollection);
  309.   CloseData ('ObjCollection', ObjCollection);
  310. End.
  311.